Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/array/vbarray.frm

Visual Basic Form | 1995-09-06 | 9.5 KB | 258 lines

VERSION 2.00
Begin Form VBArray
   BorderStyle     =   1  'Fixed Single
   Caption         =   "VB Array"
   ClientHeight    =   3225
   ClientLeft      =   1305
   ClientTop       =   1500
   ClientWidth     =   6330
   Height          =   3630
   Left            =   1245
   LinkMode        =   1  'Source
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3225
   ScaleWidth      =   6330
   Top             =   1155
   Width           =   6450
   Begin CommandButton OkCancel
      Cancel          =   -1  'True
      Caption         =   "&Quit"
      Height          =   420
      Index           =   1
      Left            =   3600
      TabIndex        =   5
      Top             =   2280
      Width           =   1095
   End
   Begin CommandButton OkCancel
      Caption         =   "&OK"
      Default         =   -1  'True
      Height          =   420
      Index           =   0
      Left            =   1920
      TabIndex        =   4
      Top             =   2280
      Width           =   1095
   End
   Begin OptionButton OtherDemo
      Caption         =   "&Some Type Array"
      Height          =   255
      Left            =   4200
      TabIndex        =   3
      Top             =   1800
      Width           =   1815
   End
   Begin OptionButton LngIntDemo
      Caption         =   "&Long Integer Array"
      Height          =   255
      Left            =   2040
      TabIndex        =   2
      Top             =   1800
      Width           =   1935
   End
   Begin OptionButton IntDemo
      Caption         =   "&Integer Array"
      Height          =   255
      Left            =   360
      TabIndex        =   1
      Top             =   1800
      Value           =   -1  'True
      Width           =   1455
   End
   Begin ListBox ListBox
      Height          =   1200
      Left            =   360
      TabIndex        =   0
      Top             =   360
      Width           =   5655
   End
   Begin Label Status
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Caption         =   "Status"
      Height          =   255
      Left            =   -120
      TabIndex        =   6
      Top             =   3000
      Width           =   6615
   End
DefInt A-Z
' VBARRAY *FAST* file I/O of arrays
' Address questions/comments/improvements to
' Costas Kitsos, CIS ID: 73667,1755
' Enjoy!
' holds a Windows supplied temp filename for the demo
Dim sTempFile As String
' listbox's hWnd so we can set tabs
Dim hWndListBox As Integer
' Flag for Application Initialization
Dim nInitApp As Integer
Function DoIntDemo () As Integer
     ' Declare variables
     Dim tTempFile As OFSTRUCT     ' Used by OpenFile function
     ReDim nBefore(50) As Integer  ' holds the Integers before I/O
     ReDim nAfter(50) As Integer   ' holds the Integers after I/O
     Dim nBytes, hFileOut, hFileIn, nIObytes, nFclose ' Integers
     Dim lMes As Long, lFileSize As Long
     ' Use the Random number generator to fill nBefore() with 50 integers
     Randomize
     For j = 1 To 50
        nBefore(j) = Int((32767 - 1 + 1) * Rnd + 1)
     Next
    ' ** I/O Starts here
    ' Create our temp file and open it for writing
    hFileOut = OpenFile(sTempFile, tTempFile, OF_CREATE Or OF_WRITE)
    ' If we have a file handle proceed
    If hFileOut <> 0 Then
    ' calculate the number of bytes to be written (NumberOfElements * Size)
    ' Since we want to write the entire array the formula would be:
    ' nBytes = UBound(Array) * Len(Array(element)).  If we only needed
    ' twenty elements then nBytes = 20 * Len(Array(element)).  Since we're
    ' dealing with fixed length arrays, element can be any legitimate
    ' array element.
        nBytes = UBound(nBefore) * Len(nBefore(1))

    ' Write nBefore() to disk using API's lwrite function.
    ' We only need to pass the first array element.  The nBytes
    ' parameter tells Windows how many bytes to write, or as far
    ' as we're concerned how many array elements.
        nIObytes = lwrite(hFileOut, nBefore(1), nBytes)
    ' Get the file size with llseek.  By specifying 0 for lOffset and
    ' and 2 for iOrigin we're saying seek position 0 from the end of
    ' the file.  In other words, give us the FileSize.
        lFileSize = llseek(hFileOut, 0, 2)
    ' close the output file.
        nFclose = lclose(hFileOut)
    ' Now let's see if it worked.  Open the file for reading.
        hFileIn = OpenFile(sTempFile, tTempFile, OF_READ)
    ' We'll use the nAfter() array this time, nBytes is the same.
        nIObytes = lread(hFileIn, nAfter(1), nBytes)
    ' close the input file.
        nFclose = lclose(hFileIn)
    ' Let's prove that it worked.  First, clear the list box.

        lMes = SendMessage(hWndListBox, LB_RESETCONTENT, 0, ByVal 0&)
    ' Add a title.
        ListBox.AddItem "Before" + Chr$(9) + "After"
    ' Add the nBefore() and nAfter() contents to the listbox
        For j = 1 To 50
        ListBox.AddItem LTrim$(Str$(nBefore(j))) + Chr$(9) + LTrim$(Str$(nAfter(j)))
        Next

        Status.Caption = "Temp File: " + sTempFile + Str$(lFileSize) + " bytes"
        DoIntDemo = True    ' success
    Else
    DoIntDemo = False       ' failure
    End If
End Function
Function DoLngIntDemo () As Integer
       ' Please see the DoIntDemo function for comments
    Dim tTempFile As OFSTRUCT
    ReDim lBefore(50) As Long
    ReDim lAfter(50) As Long
    Dim nBytes, hFileOut, hFileIn, nIObytes, nFclose
    Dim lMes As Long, lFileSize As Long
    Randomize
    For j = 1 To 50
       lBefore(j) = Int(1234532767 * Rnd + 1)
    Next
    hFileOut = OpenFile(sTempFile, tTempFile, OF_CREATE Or OF_WRITE)
    If hFileOut <> 0 Then
        nBytes = UBound(lBefore) * Len(lBefore(1))
        nIObytes = lwrite(hFileOut, lBefore(1), nBytes)
        lFileSize = llseek(hFileOut, 0, 2)
        nFclose = lclose(hFileOut)

        hFileIn = OpenFile(sTempFile, tTempFile, OF_READ)
        nIObytes = lread(hFileIn, lAfter(1), nBytes)
        nFclose = lclose(hFileIn)
        lMes = SendMessage(hWndListBox, LB_RESETCONTENT, 0, ByVal 0&)
        ListBox.AddItem "Before" + Chr$(9) + "After"
        For j = 1 To 50
        ListBox.AddItem LTrim$(Str$(lBefore(j))) + Chr$(9) + LTrim$(Str$(lAfter(j)))
        Next
        Status.Caption = "Temp File: " + sTempFile + Str$(lFileSize) + " bytes"

        DoLngIntDemo = True
    Else
    DoLngIntDemo = False
    End If
End Function
Function DoOtherDemo () As Integer
     ' Please see the DoIntDemo function for comments
    Dim tTempFile As OFSTRUCT
    ReDim tBefore(50) As SomeType
    ReDim tAfter(50) As SomeType
    Dim nBytes, hFileOut, hFileIn, nIObytes, nFclose
    Dim lMes As Long, lFileSize As Long
    Randomize
    For j = 1 To 50
        tBefore(j).nInteger = Int((32767 - 1 + 1) * Rnd + 1)
        tBefore(j).sString = Chr$(Int((90 - 65 + 1) * Rnd + 65)) + "abcde"
        tBefore(j).lLong = Int(1232767 * Rnd + 1)
    Next
    hFileOut = OpenFile(sTempFile, tTempFile, OF_CREATE Or OF_WRITE)
    If hFileOut <> 0 Then
        nBytes = UBound(tBefore) * Len(tBefore(1))
        nIObytes = lwrite(hFileOut, tBefore(1), nBytes)
        lFileSize = llseek(hFileOut, 0, 2)
        nFclose = lclose(hFileOut)
        hFileIn = OpenFile(sTempFile, tTempFile, OF_READ)
        nIObytes = lread(hFileIn, tAfter(1), nBytes)
        nFclose = lclose(hFileIn)
        lMes = SendMessage(hWndListBox, LB_RESETCONTENT, 0, ByVal 0&)
        ListBox.AddItem "Before" + Chr$(9) + "After"
        For j = 1 To 50
        Before$ = LTrim$(Str$(tBefore(j).nInteger)) + " " + tBefore(j).sString + Str$(tBefore(j).lLong)
        After$ = LTrim$(Str$(tAfter(j).nInteger)) + " " + tAfter(j).sString + Str$(tAfter(j).lLong)
        ListBox.AddItem Before$ + Chr$(9) + After$
        Next
        Status.Caption = "Temp File: " + sTempFile + Str$(lFileSize) + " bytes"
        DoOtherDemo = True
    Else
    DoOtherDemo = False
    End If
End Function
Sub Form_Load ()
    sTempFile = String$(144, 0)  ' Buffer
    ' Ask Windows for a temp file.
    nResult = GetTempFileName(0, "VBA", 0, sTempFile)
    sTempFile = Left$(sTempFile, InStr(sTempFile, Chr$(0)) - 1)
    Status.Caption = "Temp File: " + sTempFile
    nInitApp = True
End Sub
Sub Form_Paint ()
    If nInitApp = True Then
    ListBox.SetFocus
    hWndListBox = GetFocus()  ' get the listbox's hWnd
    ' Set 1 tab stop at position 105
    Mes& = SendMessage(hWndListBox, LB_SETTABSTOPS, 1, 105)
    OkCancel(0).SetFocus
    nInitApp = False  'set the flag to FALSE so we don't repeat this
    End If
End Sub
Sub Form_Unload (Cancel As Integer)
    Dim tTempFile As OFSTRUCT   ' Used by OpenFile
   ' If our temp file exists, delete it.
    If OpenFile(sTempFile, tTempFile, OF_EXIST) <> 0 Then nRemoveTemp = OpenFile(sTempFile, tTempFile, OF_DELETE)
    End
End Sub
Sub OkCancel_Click (Index As Integer)
    If Index = 0 Then

    If IntDemo.Value = True Then  ' Do the Integer Array demo
        If Not DoIntDemo() Then MsgBox "Integer Demo Failed", 16, VBARRAY.Caption
    End If

    If LngIntDemo.Value = True Then  ' Do the Long Integer Array demo
        If Not DoLngIntDemo() Then MsgBox "Long Integer Demo Failed", 16, VBARRAY.Caption
    End If
    If OtherDemo.Value = True Then   ' Do the SomeType Array demo
        If Not DoOtherDemo() Then MsgBox "Some Type Demo Failed", 16, VBARRAY.Caption
    End If
    Else
    Call Form_Unload(0)  ' Quit pressed
    End If
End Sub